home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0056_Which Compiler.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  12KB  |  364 lines
  1. {
  2. Hi !
  3.  
  4.    Here is some source code I acquired from a Pascal echo some time
  5.    ago. It shows one method of detecting which TP compiler created
  6.    an .EXE:
  7.  
  8. -------------------------------------------------------------------
  9. { to compile type: tpc foo.pas }
  10. { exe: 9776 bytes by TP5.5 }
  11.  
  12. {$A+,B-,E-,F-,I+,N-,O-,V+}
  13. {$M 4500,0,0}
  14. {$ifndef debug}
  15. {$D-,L-,R-,S-}
  16. {$else}
  17. {$D+,L+,R+,S+}
  18. {$endif}
  19.  
  20. Program foo;
  21.  
  22. Uses
  23.    DOS;  { dos unit from turbo pascal }
  24.  
  25. TYPE              { normal exe file header }
  26.     EXEH = RECORD
  27.           id,            { exe signature }
  28.           Lpage,         { exe file size mod 512 bytes; < 512 bytes }
  29.           Fpages,        { exe file size div 512 bytes; + 1 if Lpage > 0 }
  30.           relocitems,    { number of relocation table items }
  31.           size,          { exe header size in 16-byte paragraphs }
  32.           minalloc,      { min mem. required in additional to exe image }
  33.           maxalloc,      { extra max. mem. desired beyond that required
  34.                            to hold exe's image }
  35.           ss,            { displacement of stack segment }
  36.           sp,            { initial SP register value }
  37.           chk_sum,       { complemented checksum }
  38.           ip,            { initial IP register value }
  39.           cs,            { displacement of code segment }
  40.           ofs_rtbl,      { offset to first relocation item }
  41.           ovr_num : word; { overlay numbers }
  42.        END;
  43.                 { window exe file header }
  44.     WINH = RECORD
  45.           id : word;     { ignore the rest of data structures }
  46.        END;
  47.  
  48.     str2  = string [2];
  49.     str4  = string [4];
  50.     str10 = string [10];
  51.  
  52. CONST
  53.     no_error  = 0;        { no system error }
  54.     t         = #9;       { ascii: hortizon tab }
  55.     dt        = t+t;
  56.     tt        = t+t+t;
  57.     qt        = t+t+t+t;
  58.     cr        = #13#10;   { ascii: carriage return and line feed }
  59.  
  60. VAR
  61.     f        : file;      { source file, untyped }
  62.     exehdr   : exeh;      { exe header contents }
  63.     winhdr   : winh;      { window exe header contents }
  64.     blocks_r : word;      { number of blocks actually read }
  65.  
  66.     exe_size ,            { exe file length }
  67.     hdr_size ,            { exe header size }
  68.     img_size ,            { load module or exe image size }
  69.     min_xmem ,            { min. extra memory needed }
  70.     max_xmem ,            { max. extra memory wanted }
  71.     o_starup : longint;   { offset to start up code }
  72.  
  73.     dirfile    : searchrec;
  74.     compressed : boolean;
  75.  
  76. function Hex(B :byte) :str2;
  77.  CONST  strdex :array [0..$F] of char = '0123456789ABCDEF';
  78.  BEGIN  Hex := concat(strdex[B shr 4], strdex[B and $F]); END;
  79.  
  80. function HexW(W :word) :str4;
  81.  VAR    byt :array [0..1] of byte absolute W;
  82.  BEGIN  HexW := Hex(byt[1])+Hex(byt[0]); END;
  83.  
  84. function HexL(L :longint) :str10;
  85.  TYPE   Cast = RECORD
  86.                 Lo :word;
  87.                 Hi :word;
  88.          END;
  89.  BEGIN  HexL := HexW(Cast(L).Hi)+' '+HexW(Cast(L).Lo); END;
  90.  
  91. procedure print_info;
  92.    CONST
  93.       psp_size = $100; { size of psp, bytes }
  94.    VAR   i : byte;
  95.    BEGIN
  96.       hdr_size := longint(exehdr.size) shl 4;       { exe header size, bytes }
  97.       img_size := longint(exe_size) - hdr_size;     { exe image size, bytes }
  98.       min_xmem := longint(exehdr.minalloc) shl 4;   { mim xtra mem, bytes }
  99.       max_xmem := longint(exehdr.maxalloc) shl 4;   { max xtra mem, bytes }
  100.       o_starup := hdr_size + longint(exehdr.cs) shl 4
  101.                   +longint(exehdr.ip);              { ofs to start up code  }
  102.       writeln(
  103.          qt, 'Dec':8, '':6, 'Hex', cr,
  104.          'EXE file size:', tt, exe_size:8, '':3, hexl(exe_size), cr,
  105.          'EXE header size:', dt, hdr_size:8, '':3, hexl(hdr_size), cr,
  106.          'Code + initialized data size:', t, img_size:8, '':3, hexl(img_size)
  107.              );
  108.  
  109.       writeln(
  110.          'Pre-relocated SS:SP', tt, '':3, hexw(exehdr.ss), ':', hexw(exehdr.sp)
  111.          , cr,
  112.          'Pre-relocated CS:IP', tt, '':3, hexw(exehdr.cs), ':', hexw(exehdr.ip)
  113.              );
  114.  
  115.       writeln(
  116.          'Min. extra memory required:', t, min_xmem:8, '':3, hexl(min_xmem), cr,
  117.          'Max. extra memory wanted:', t, max_xmem:8, '':3, hexl(max_xmem), cr,
  118.          'Offset to start up code:', dt, '':3, hexl(o_starup), cr,
  119.          'Offset to relocation table:', dt, '':3, hexw(exehdr.ofs_rtbl):9
  120.              );
  121.  
  122.      writeln(
  123.          'Number of relocation pointers:', t, exehdr.relocitems:8, cr,
  124.          'Number of MS overlays:', dt, exehdr.ovr_num:8, cr,
  125.          'File checksum value:', tt, '':3, hexw(exehdr.chk_sum):9, cr,
  126.          'Memory needed to start:', dt, img_size+min_xmem+psp_size:8
  127.             );
  128. END; { print_info }
  129.  
  130. procedure id_signature;    { the core of this program }
  131.    CONST
  132.       o_01    =  14;        { relative offset from cstr0 to cstr1 }
  133.       o_02    =  16;        {   "        "      "  cstr0 to cstr2 }
  134.       o_03    =  47;        {   "        "      "  cstr0 to cstr3 }
  135.       cstr0   = 'ntime';    { constant string existed in v4-6 }
  136.       cstr1   = 'at '#0'.'; { constant string existed in v4-6 }
  137.       cstr2   = '$4567';    { constant string existed in v5-6 }
  138.       cstr3   = '83,90';    { constant string existed in v6 only }
  139.       strlen  =   5;        { length of cstr? }
  140.       ar_itm  =   3;        { items+1 of string array }
  141.  
  142.    { the following figures have been turn-up explicitly and
  143.      should not be changed }
  144.  
  145.       ofs_rte =  25 shl 4;  { get close to 'run time error' str contants }
  146.       maxchar =  11 shl 4;  { max. size of buffer; for scanning }
  147.  
  148.    TYPE
  149.       arstr  = array [0..ar_itm] of string[strlen];
  150.       arbuf  = array [0..maxchar] of char;
  151.  
  152.    VAR
  153.       i, j, k : word;    { index counter for array buffer }
  154.       cstr    : arstr;   { signatures generated by tp compiler }
  155.       o_fseg  : word;    { to hold segment value of any far call }
  156.       o_sysseg: longint; { offset to tp system_unit_segment }
  157.       buffer  : arbuf;   { searching for target strings }
  158.  
  159.    BEGIN
  160. {d}   Seek(f, o_starup + 3);                       { move file pointer 
  161. forward 3 bytes }
  162. {d}   BlockRead(f, o_fseg, sizeof(o_fseg));        { get far call segment 
  163. value }
  164.       o_sysseg := longint(o_fseg) shl 4 +hdr_size; { ofs to system obj code }
  165.       if (o_sysseg + ofs_rte <= dirfile.size) then
  166.       BEGIN
  167. {d}      Seek(f, o_sysseg+ofs_rte);                { offset nearby tp 
  168. signatures }
  169. {d}      BlockRead(f, buffer, sizeof(buffer), blocks_r);
  170.          for i := 0 to ar_itm do
  171.          BEGIN
  172.              cstr[i][0] := char(strlen);
  173.              fillchar(cstr[i][1], strlen, '*');
  174.          END;
  175.          i := 1; j := 1; k := 0;
  176.          repeat
  177.             if buffer[i] in ['n','t','i','m','e'] then
  178.             BEGIN
  179.                if (k > 0) and (k = i - 1) then
  180.                   inc(j);
  181.                cstr[0][j] := buffer[i];
  182.                k := i;
  183.             END;
  184.             inc(i);
  185.          until (cstr[0] = cstr0) or (i > maxchar) or (j > strlen);
  186.          if (i+o_03 <= maxchar) then
  187.          BEGIN
  188.             dec(i, strlen);
  189.             move(buffer[i+o_01], cstr[1][1], strlen);
  190.             if (cstr[1] = cstr1) then
  191.             BEGIN
  192.                writeln(
  193.                     cr, 'Offset to TP system code:', dt, '':3,
  194.                     hexl(o_sysseg):9
  195.                       );
  196.  
  197.                write('Compiled by Borland TP v');
  198.  
  199.                move(buffer[i-o_02], cstr[2][1], strlen);
  200.  
  201.                if (cstr[2] = cstr2) then
  202.                BEGIN
  203.                   move(buffer[i+o_03], cstr[3][1], strlen);
  204.                   if (cstr[3] = cstr3) THEN
  205.                      writeln('6.0')
  206.                   ELSE
  207.                      writeln('5.0/5.5');
  208.                END
  209.                ELSE
  210.                   writeln('4.0');
  211.             END;
  212.          END;
  213.       END;
  214.    END; {procedure}
  215.  
  216. procedure process_exefile;
  217.    CONST
  218.       ofs_whdr  = $3C;      { offset to MS-Window exe file id }
  219.       exwid     = $454E;    { MS-Window exe file id }
  220.    VAR
  221.       o_sign,
  222.       fsize   :longint;
  223.    BEGIN
  224.       if (exe_size = dirfile.size) then
  225.       BEGIN
  226.          print_info;
  227.          if not compressed then
  228.             id_signature;
  229.          writeln;
  230.       END
  231.       else
  232.       BEGIN
  233. {d}      Seek(f, ofs_whdr);        { offset to 'offset to window exe 
  234. signature' }
  235. {d}      BlockRead(f, hdr_size, sizeof(hdr_size));
  236. {d}      if (hdr_size <= dirfile.size) then
  237.          BEGIN
  238.             Seek(f, hdr_size);     { offset to new exe signature }
  239. {d}         BlockRead(f, winhdr, sizeof(winhdr));
  240.          END;
  241.          if (winhdr.id = exwid) then
  242.          BEGIN
  243.             writeln('Dos/MS-Window EXE or DLL file');
  244.             print_info;
  245.             EXIT;
  246.          END
  247.          else
  248.          BEGIN
  249.             print_info;
  250.             writeln(
  251.                cr,
  252.                'file size (', exe_size, ') calculated from EXE header ',
  253.                '(load by DOS upon exec)', cr,
  254.                'doesn''t match with file size (', dirfile.size, ') ',
  255.                'recorded on file directory.', cr, cr,
  256.                '* EXE file saved with extra bytes at eof (e.g. debug info)', cr,
  257.                '* EXE file may contain overlays', cr,
  258.                '* possible a corrupted EXE file', cr
  259.                    );
  260.  
  261.             EXIT;
  262.          END;
  263.       END;
  264.    END;
  265.  
  266. procedure id_file;
  267.    CONST
  268.       exeid = $5A4D;    { MS-DOS exe file id }
  269.  
  270.    VAR
  271.       zero : str2;
  272.  
  273.    BEGIN
  274.       if (exehdr.id = exeid) then
  275.       BEGIN
  276.          if (exehdr.cs = $FFF0) and
  277.             (exehdr.ip = $0100) and
  278.             (exehdr.ofs_rtbl = $50) or
  279.             (exehdr.ofs_rtbl = $52) then
  280.           BEGIN
  281.              writeln('Compressed by PKLITE');
  282.              compressed := true;
  283.           END;
  284.           if (exehdr.size = 2) and (exehdr.chk_sum = $899D) then
  285.           BEGIN
  286.              writeln( 'Compressed by DIET');
  287.              compressed := true;
  288.           END;
  289.           if (exehdr.Lpage > 0) then
  290.              exe_size := longint(exehdr.Fpages - 1) shl 9+exehdr.Lpage
  291.           else
  292.              exe_size := longint(exehdr.Fpages) shl 9;
  293.           process_exefile;
  294.       END
  295.       else
  296.          writeln('Not EXE file');
  297.    END; {procedure}
  298.  
  299. CONST
  300.    blocksize = 1; { file r/w block size in one-byte unit }
  301.  
  302. VAR
  303.    path : dirstr;
  304.    name : namestr;
  305.    ext  : extstr;
  306.    fstr : string[48];
  307.    n    : byte;
  308.  
  309. BEGIN
  310.    if paramcount < 1 then
  311.       n := 0
  312.    else
  313.       n := 1;
  314.  
  315.    fsplit(paramstr(n), path, name, ext);
  316.    if (name+ext = '*.*') or (name+ext = '.' ) or (name+ext = '' ) then
  317.       fstr := path+'*.exe'
  318.    else
  319.       if (path+ext = '') then
  320.          fstr := paramstr(n)+'.exe'
  321.       else
  322.          if not boolean(pos('.', ext)) then
  323.          BEGIN
  324.             path := path+name+'\';
  325.             fstr := path+'*.exe';
  326.          END
  327.          else
  328.             fstr := paramstr(n);
  329.  
  330.     n := 0;
  331. {d} findfirst(fstr, anyfile, dirfile);
  332.     while (doserror = no_error) do
  333.     BEGIN
  334.        if (dirfile.attr and volumeid <> volumeid) and
  335.           (dirfile.attr and directory <> directory) and
  336.           (dirfile.attr and sysfile <> sysfile) then
  337.        BEGIN
  338.           compressed := false;
  339.           Assign(f, path+dirfile.name); {$I-}
  340. {d}       Reset(f, blocksize); {$I+}
  341.           if (IOResult = no_error) then
  342.           BEGIN
  343.              writeln(cr, dirfile.name);
  344. {d}          BlockRead(f, exehdr, sizeof(exehdr), blocks_r);
  345.              if (blocks_r = sizeof(exehdr)) then
  346.                 id_file
  347.              else
  348.                 writeln('err:main');
  349.              close(f);
  350.              inc(n);
  351.           END;
  352.        END;
  353. {d}    findnext(dirfile);
  354.     END;
  355.  
  356.     if (n = 0) then
  357.        if doserror = 3 then
  358.           writeln('path not found')
  359.        else
  360.           writeln('file not found')
  361.        else
  362.           writeln(n,' files found');
  363. END.
  364.